perm filename PFAIL.FAI[MSS,LCS]4 blob
sn#191291 filedate 1975-12-10 generic text, type T, neo UTF8
00100 TITLE PFAIL; ********* OCT 16,75 *********
00200 INTERNAL LOOK,LOOKD,LOOKF
00300 ENTRY GETPTS,MOVIT,EXTEN,PNRN,DBAR,SORT,SHIFT,SHFT1
00400 ENTRY ADRST,SHFT0,PSHFT,ENDL,STAFF,RIGHT,LOOP1,RESTS
00500 ENTRY EXCHG,SHRNK,EXPND,CLFNUM,SLRV
00600 DEFINE ERROR (MSG)
00700 < JSA 16,.ERROR
00800 JUMP [ASCIZ/MSG/
00900 ]
01000 >
01100
01200 .ERROR: 0
01300 OUTSTR [ASCIZ/?
01400 /] ;MAKE SURE HE CAN SEE HIS ERROR
01500 OUTSTR @(16) ;OUTPUT ERROR MESSAGE
01600 CALLI 1,12 ;LET USER CONTI2UE
01700 JRA 16,1(16)
01800
01900 CH←13
02000
02100 REGS: BLOCK 20
02200
02300 ;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
02400
02500
02600 LOOKF: 0
02700 MOVSI 0,'DMD'
02800 JRST LOOK1
02900 LOOKD: 0
03000 MOVSI 0,'DAT'
03100 JRST LOOK1
03200 LOOK: 0
03300 MOVEI 0,0
03400 LOOK1: MOVEM 0,DIR+1
03500 MOVE 0,@(16)
03600 MOVEM 0,FILNAM
03700 JSA 16, INTFIQ
03800 SETZM DIR+2
03900 SETZM DIR+3
04000 LOOKUP CH,DIR
04100 TDZA 0,0
04200 MOVNI 0,1
04300 JRA 16,1(16)
04400
04500 INTFIQ: 0 ;INITS DSK FOR INPUT
04600 MOVEI REGS
04700 BLT REGS+3
04800 INIT CH,17
04900 SIXBIT/DSK/
05000 0
05100 HALT .-3
05200 ; ERROR <CAN'T INIT DSK!>
05300
05400 INTF4: MOVE 0,FILNAM#
05500 MOVEM 0,FN#
05600 MOVE 1,[POINT 7,FN]
05700 INTF3: MOVE 2,[POINT 6,DIR]
05800 SETZM DIR
05900 MOVEI 3,5
06000 INTF1: ILDB 0,1
06100 CAIN 0," "
06200 JRST INTF2
06300 SUBI 0,40
06400 IDPB 0,2
06500 SOJG 3,INTF1
06600 INTF2: HRLZI REGS
06700 BLT 3
06800 JRA 16,0(16)
06900
07000 DIR: BLOCK 4
07100 EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP,PX,XXX,Q,SF,LLL
07200 EXTERNAL RCLF,STF,PTMOVE
07300 K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
07400 DEFINE FIXX(N)
07500 < JUMPGE N,.+5
07600 MOVNS N
07700 FIX N,233000
07800 MOVNS N
07900 CAIA
08000 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
08100
08200 ; SUBROUTINE GETPTS
08300 ; COMMON/KNR/N(500) /NNP/NP(500)
08400 ;XXX COMMON/XRN/RN(4000) /KJY/ K,J
08500 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
08600 ;XXX 1/PTR/PWDS(250),ITEM,LL,I,IX
08700 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
08800 ; 1,(R6,RJQ(4))
08900
09000 GETPTS: 0 ;CALL GETPTS(N,RN,PWDS)
09100 SETZ J, ; J=0
09200 SETZ K, ; K=0
09300 MOVE JJ2,POSI+=8
09400 MOVE R2,.COMM.
09500 SETZ X,
09600 ;; MOVE X,@(16)
09700 ;; SOJ X
09800 MOVEI M,@2(16); DO 1 M=1,ITEM
09900 ; ADDI M,(X)
10000 G1: AOJ X,
10100 MOVE L,(M)
10200 ;; FIXX(L)
10300 MOVEI R,@1(16) ;L=PWDS(M)
10400 ADDI R,(L) ;IF(RTLINE(L))GO TO 1
10500 ;* MOVE 1,1(R) ;RN(L+2)
10600 ;;NEVER USED IN 'PARTS'- CAML R2,[=5.0]
10700 ;; JRST GZ
10800 CAME R2,1(R)
10900 JRST GX
11000 ;;GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
11100 ;; JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
11200 ;; CAME A,(R) ;IF(R6.NE.RY)GO TO 1
11300 ;; JRST GX
11400 ; CHECK CODE NUM
11500 G9: MOVE A,2(R)
11600 CAMLE A,.COMM.+6 ;R5
11700 JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
11800 CAMGE A,.COMM.+5 ;R4
11900 JRST G2
12000
12100 SKIPG JJ2
12200 MOVE JJ2,X
12300 MOVE .COMM.+=8 ;RN(L+2)=R7
12400 MOVEM 1(R)
12500 AOJ J,
12600 ; IN LIMITS?
12700 ; MOVEI A,XRN+=2498 ;J=J+1
12800 ;; MOVEI A,KNR-1
12900 ;; ADDI A,(J)
13000 MOVEI 0,(L)
13100 AOJ K, ;K=K+1
13200 ;; MOVEI 1,NNP-1
13300 ;; ADDI 1,(K) ;NP(K)=L
13400 MOVEM 0,NNP-1(K)
13500 ADDI 0,3 ;N(J)=L+3
13600 MOVEM 0,KNR-1(J)
13700 ; NP IS FOR USE IN JUSTIFY ROUTINE
13800 G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
13900 CAMGE RY,[=4.0]
14000 JRST GX
14100 CAMN RY,[=44.0] ;CODE 4 IS SOMETIMES =44
14200 JRST G5 ;FOUND A LINE
14300 CAMLE RY,[=7.0]
14400 JRST GX ;IF(RY.GT.7)GO TO 1
14500 ; TWO-ENDED ITEM?
14600 MOVE RZ,-1(R) ;RZ=RN(L)
14700 ; WD CNT
14800 ;; CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
14900 ;; JRST G4
15000 ;; CAMN RY,[=5.0]
15100 ;; JRST G5
15200 ;; CAMN RY,[=6.0]
15300 ;; JRST G6
15400 ;; CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
15500 ;; JRST G5 ; THERE IS A TRILL WIGGLE
15600 ;; JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
15700 FIXX(RY)
15800 XCT TBL-4(RY) ; NEXT REPLACES THE ABOVE.
15900 JRST G5
16000 JRST GX
16100 TBL: JRST G4
16200 JRST G5
16300 JRST G6
16400 CAMG RZ,[4.0]
16500
16600 G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
16700 JRST GX
16800 JRST G5 ;GO TO 1
16900 G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
17000 JRST G8
17100 ;; MOVEI 1,XRN ;IF(RN(L+10).LT.30)GO TO 8
17200 ;; ADDI 1,(L)
17300 ;; MOVE 1,11(1)
17400 MOVE 1,=9(R)
17500 CAMGE 1,[=30.0]
17600 JRST G8
17700 MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
17800 CAMLE A,.COMM.+6
17900 JRST G8
18000 CAMGE A,.COMM.+5
18100 JRST G8
18200 SKIPG JJ2
18300 MOVE JJ2,X
18400 AOJ J,
18500 ; IN LIMITS?
18600 ; MOVEI A,XRN+=2498 ;J=J+1
18700 ; ADDI A,(J)
18800 MOVEI 0,8(L) ;J=J+1
18900 ;; ADDI 0,=8 ;N(J)=L+8
19000 MOVEM 0,KNR-1(J)
19100 G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
19200 JRST G5
19300 ;; MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
19400 ;; JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
19500 ;; MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
19600 ;; JUMPN A,G8B
19700 SKIPL 6(R)
19800 SKIPE 7(R)
19900 JRST G8B
20000
20100 CAMGE RZ,[=8.0]
20200 JRST G5 ;IF(RZ.LT.8)GO TO G5
20300 MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
20400 JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
20500 G8B: MOVE A,8(R)
20600 CAMLE A,.COMM.+6
20700 JRST G5
20800 CAMGE A,.COMM.+5 ;R4
20900 JRST G5
21000
21100 SKIPG JJ2
21200 MOVE JJ2,X
21300 AOJ J, ;J=J+1
21400 ; IN LIMITS?
21500 ; MOVEI A,XRN+=2498 ;J=J+1
21600 ; ADDI A,(J)
21700 MOVEI 0,=9(L)
21800 ;; ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
21900 MOVEM 0,KNR-1(J) ;N(J)=L+9
22000 G5: MOVE A,5(R)
22100 CAMLE A,.COMM.+6
22200 JRST GX
22300 CAMGE A,.COMM.+5 ;R4
22400 JRST GX
22500
22600 SKIPG JJ2
22700 MOVE JJ2,X
22800 AOJ J,
22900 ; IN LIMITS?
23000 ;| MOVEI A,XRN+=2498 ;J=J+1
23100 ;; ADDI A,(J)
23200 MOVEI 0,6(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
23300 ;; ADDI 0,6 ;N(J)=L+6
23400 MOVEM 0,KNR-1(J)
23500 ;;GX: CAMGE X,PTR+=250 ;1 CONTINUE
23600 GX: CAMGE X,LLL ;1 CONTINUE
23700 AOJA M,G1
23800 MOVEM JJ2,POSI+=8
23900 MOVEM J,KJY+1
24000 MOVEM K,KJY
24100 JRA 16,3(16)
24200
24300 ; SUBROUTINE MOVIT(RN)
24400 ; COMMON /KNR/ N(500)
24500 ; COMMON /KJY/ DONT,J
24600 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
24700 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
24800 ; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
24900 MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
25000 MOVE R,.COMM.+=10
25100 FSBR R,.COMM.+=9
25200 MOVE RY,.COMM.+6
25300 FSBR RY,.COMM.+5
25400 FDVR R,RY
25500 ; MOVEI L,XRN+=2499 ; DO 1 K=1,J
25600 MOVEI L,KNR
25700 SETZ K,
25800 MOVE 0,.COMM.+=10 ; SET UP R9
25900 ;;M1: MOVE X,L ; L=N(K)
26000 ;; MOVE A,(X)
26100 M1: MOVE A,(L)
26200 MOVEI R2,@(16) ;RA=RN(L)
26300 ADDI R2,(A)
26400 MOVEI RZ,(R2)
26500 MOVE R2,-1(R2)
26600 CAMGE R2,.COMM.+5 ;IF(OUTLIM(R4,R5,RA))GO TO 1
26700 JRST MX
26800 CAMLE R2,.COMM.+6
26900 JRST MX
27000 JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
27100 FSBR R2,.COMM.+5
27200 FMPR R2,R
27300 M2: FADR R2,.COMM.+=9 ; RN(L)=R8+RA
27400 MOVEM R2,-1(RZ)
27500 MX: AOJ K, ;1 CONTINUE
27600 CAMGE K,KJY+1
27700 AOJA L,M1
27800 JRA 16,1(16)
27900
28000 EXTEN: 0 ;FUNCTION EXTEN(X)
28100 HRRM 16,.+2
28200 JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
28300 JUMP @0
28400 JUMP [=1.0]
28500 FMPR [=10.0]
28600 JRA 16,1(16)
28700
28800
28900 DBAR: 0 ; CALL DBAR(K,ITEM,J)
29000 MOVE 4,@2(16) ; -J-RR=RN(J+3)
29100 MOVE 2,XRN+3(4) ; -RN(J+4)-
29200 FIXX(2) ;KZ=RN(J+4)/100.
29300 IDIVI 2,=100
29400 IMULI 2,=100 ;RN(J+4)=1.+KZ*100.
29500 AOJ 2,
29600 TLC 2,232000
29700 FADR 2,2 ;FLOAT IT
29800 MOVEM 2,XRN+3(4)
29900
30000 MOVE 1,@1(16)
30100 ;;??? SOJ 1, ; ITEM-1
30200 MOVE 7,XRN+2(4) ; -RR-
30300 MOVE 4,@(16) ; DO 82 KY=K+1,ITEM
30400 DB: MOVE 5,PTR(4) ;KZ=PWDS(KY)
30500 ;; FIXX(5) ; -KY-
30600 MOVE 6,XRN(5) ; IF(RN(KZ+1).NE.4)GO TO 82
30700 CAME 6,[4.0]
30800 JRST DB82
30900 MOVE 6,XRN-1(5) ;IF(RN(KZ).NE.2)GO TO 82
31000 CAME 6,[2.0]
31100 JRST DB82
31200 ;;C AVOIDS DUPLICATE BARS.
31300 MOVN 6,XRN+2(5) ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82
31400 FADR 6,7
31500 SKIPGE 6
31600 MOVNS 6
31700 CAMLE 6,[0.5]
31800 JRST DB82
31900 MOVE 6,[99.0] ;RN(KZ+2)=99
32000 MOVEM 6,XRN+1(5)
32100 SETZM XRN(5) ;RN(KZ+1)=0
32200 DB82: AOJ 4, ;82 CONTINUE
32300 CAIGE 4,(1)
32400 JRST DB
32500 MOVEM 7,SHFT1 ; RR SAVES IT FOR ADRST ROUTINE
32600 JRA 16,3(16)
32700
32800 PNRN: 0 ; CALL PNRN(J,XWDS,K)
32900 MOVE 4,@(16) ;810 JA=PWDS(K+1)
33000 ;; MOVE 3,.COMM. ;RN(J+2)=RS
33100 SETZM XRN+1(4)
33200 MOVE 5,@2(16) ; DO 7 KY=J,JA-1
33300 MOVE 5,PTR(5)
33400 ;; FIXX(5) ; -JA-
33500 MOVE 6,XXX ; PN(LK)=RN(KY)
33600 MOVEI 1,(6) ; SAVE IT FOR A LITTLE LATER
33700 PN: MOVE 7,XRN-1(4) ;7 LK=LK+1
33800 MOVEM 7,PX-1(6)
33900 AOJ 4,
34000 CAME 4,5
34100 AOJA 6,PN
34200 AOJ 6,
34300 MOVE 2,.COMM.+6 ; IF(R5)GO TO 6666
34400 JUMPL 2,PN2 ; IF(PN(J).EQ.2)LK=LK+1
34500 MOVEM 2,PX+4(1) ; PN(J+5)=R5
34600 MOVE 3,[3.0]
34700 PN3: MOVE 4,3 ; IS THE WDCNT BIG ENOUGH?
34710 FSBR 4,PX-1(1)
34720 FIXX(4)
34730 ADD 6,4 ; UPDATE THE MAIN COUNTER
34740 SETZM PX+3(1) ; ZERO PARAM 4, THE VERTICAL POS. PN(J+4)
34900 MOVEM 3,PX-1(1) ; PN(J)=3 OR 4
35000 JRST PN1
35100 PN2: MOVE 3,RCLF ; IF(R.NE.17)GO TO
35200 CAME 3,[17.0]
35300 JRST PN1
35400 MOVE 3,[4.0] ; THE WDCNT
35500 MOVE 2,RCLF+1 ; CLEF #
35600 MOVEM 2,PX+5(1) ;PN(J+6)=CLEF
35700 JRST PN3
35800 PN1: MOVEM 6,XXX ;LK=LK+1 (6666↑)
35900 MOVE 4,LLL ; -L-
36000 ;; TLC 6,232000 ;XWDS(L)=LK
36100 ;; FADR 6,6
36200 ADD 4,1(16) ; ADDR. XWDS ARRAY
36300 MOVEM 6,(4)
36400 AOS LLL ;L=L+1
36500 JRA 16,3(16)
36600 SORT: 0 ; CALL SORT(XWDS)
36700 MOVE 11,LLL ; L
36800 SOJ 11,
36900 MOVEI 4,1 ;I=1
37000 SETZ 5, ; -K- DO 243 K=1,L-1
37100 S2: MOVE 7,(16) ; ADDR. OF XWDS
37200 ADDI 7,(5) ;LB=XWDS(K)+1
37300 MOVE 6,(7)
37400 ;; FIXX(6) ; I DON'T NEED THE -1.
37500 MOVE 10,PX(6) ;IF(PN(LB).NE.16)GO TO 243
37600 CAME 10,[16.0]
37700 JRST S243
37800 MOVE 10,PX-1(6) ;IF(PN(LB-1).LT.8)GO TO 243
37900 CAMGE 10,[8.0]
38000 JRST S243
38100 MOVE 10,-1(7) ;JL=XWDS(K-1)
38200 ;; FIXX(10)
38300 MOVE 10,PX+2(10)
38400 MOVEM 10,PX+2(6) ;244 PN(LB+2)=PN(JL+3)
38500 S243: AOJ 5,
38600 CAME 5,11 ; -L-1
38700 JRST S2 ; 243 CONTINUE
38800
38900 ;; PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
39000 ;; FOR SPACING PROBLEMS BELOW.
39100 MOVEI 11,1 ;M=2
39200 SETZ 12, ;J=1
39300 S24: MOVE 13,[100000.0] ;24 RA=100000.
39400 ;; POSITION
39500 MOVE 1,LLL ; L
39600 SOJ 1,
39700 SETZ 14, ; -K-
39800 S21: MOVE 2,(16) ;DO 21 K=1,L-1 - ADDR. OF XWDS -
39900 ADDI 2,(14) ;JL=XWDS(K)+3
40000 MOVE 2,(2)
40100 ;; FIXX(2) ; -JL- (NO +3)
40200 MOVE 3,PX+2(2) ;R=PN(JL)
40300 CAMN 3,[100000.0]
40400 JRST SX21 ;IF(R.EQ.100000)GO TO 21
40500 MOVE 3 ;241 IF(ABS(R-RA).GT..1)GO TO 240
40600 FSBR 13
40700 SKIPGE
40800 MOVNS
40900 CAMLE 0,[0.1]
41000 JRST S240
41100 MOVEM 13,PX+2(2) ; ((R=RA)) PN(JL)=R
41200 ;; PUT IN HERE MULTI-VOICE TRAP SOMEDAY
41300 JRST SX21 ;GO TO 21
41400 S240: CAMLE 3,13 ;240 IF(R.GT.RA)GO TO 21
41500 JRST SX21
41600 ;; LINES THEM UP
41700 MOVEI 4,(2) ; SAVES JL (I=K)
41800 MOVE 13,3 ; RA=R ;21 CONTINUE
41900 SX21: AOJ 14, ; -K-
42000 CAME 14,1
42100 JRST S21
42200 CAMN 13,[100000.0] ;IF(RA.EQ.100000)GO TO 23
42300 JRA 16,1(16); JUMP IF ALL SORTED
42400 ;;;; MOVE 10,(16) ;242 JL=XWDS(I)
42500 ;;;; ADDI 10,(4)
42600 ;;;; MOVE 10,(10) ; AC4 IS I-1
42700 ;;;; FIXX(10) ; -JL-
42800 MOVEI 15,(4) ;LA=JL
42900 MOVE 1,PX-1(4) ;N=PN(JL)+3
43000 FIXX(1)
43100 ADDI 1,3 ; N
43200 MOVE 2,PTR-1(11) ; PWDS(M)=PWDS(M-1)+N
43300 ADDI 2,(1)
43400 MOVEM 2,PTR(11)
43500 AOJ 11, ; M=M+1
43600 ;; FIXX(1) ;DO 22 K=J,J+N-1
43700 ADDI 1,(12) ; -J+N-
43800 ;; SOJ 1,
43900 S22: MOVE 2,PX-1(4) ; RN(K)=PN(JL)
44000 MOVEM 2,XRN(12)
44100 AOJ 12,
44200 CAME 12,1
44300 AOJA 4,S22 ;22 JL=JL+1
44400 AOJ 4, ; (JL=JL+1)
44500 ;; AOJ 12, ; (J=J+N)
44600 MOVE 2,[100000.0] ; PN(LA+3)=100000
44700 MOVEM 2,PX+2(15) ; PUT IT ASIDE
44800 ;? AOJ 12, ; (J=N+J)
44900 JRST S24 ; GO TO 24
45000 SHIFT: 0 ; CALL SHIFT
45100 SOS LLL ; (IN MAIN. L=L-1)
45200 SETZ 2, ;K=1
45300 SETZ 3, ;L=1
45400 SETO 4, ;LK=1 ((LL=0))
45500 SH221: MOVE 5,PX(2) ;221 IF(Q(IFIX(PN(K))+1))GO TO 321
45600 ;; FIXX(5)
45700 MOVE 6,Q(5)
45800 JUMPL 6,SH321
45900 MOVE 7,PX+1(2)
46000 ;; FIXX(7)
46100 SH421: MOVE 6,Q-1(5) ;DO 421 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
46200 MOVEM 6,Q(3) ; ((LL=LL+1))421 Q(LL)=Q(KL)
46300 AOJ 5,
46400 CAMGE 5,7
46500 AOJA 3,SH421
46600 AOJ 4, ;LK=LK+1
46700 AOJ 3,
46800 MOVE 1,3 ;PN(LK)=LL+1
46900 AOJ 1,
47000 ;; TLC 1,232000
47100 ;; FADR 1,1
47200 MOVEM 1,PX+1(4)
47300 SH321: AOJ 2, ;321 K=K+1
47400 CAMGE 2,LLL ; (L) IF(K.LT.KK)GO TO 221
47500 JRST SH221
47600 AOJ 4,
47700 MOVEM 4,LLL ; L=LK-1
47800 ;; L=NUMBER OF ITEMS FOR RHY RECONS.
47900 JRA 16,(16)
48000
48100 SHFT1: 0 ; CALL SHFT1(KQ)
48200 MOVEI 2,1 ; -L- (KK=1)
48300 ;; MOVEI 3,1 ; K
48400 MOVEI 6,1 ; -K-
48500 SP: MOVE 4,Q-1(6) ;220 JJ=Q(K)+3
48600 FIXX(4)
48700 ADDI 4,3
48800 MOVEM 6,PX-1(2)
48900 ;;NEW POINTER
49000 MOVE Q(6) ;IF(Q(K+1).NE.2.OR.Q(K).LT.6)GO TO SPA
49100 CAME [2.0]
49200 JRST SPA
49300 MOVE [6.0]
49400 CAMLE Q-1(6)
49500 JRST SPA
49510 MOVEI 13,(4) ; JJ
49520 ADDI 13,(6) ; +K
49530 ;; SOJ 13, ; -1
49600 MOVE 3,Q(13) ;IF(Q(JJ+1).NE.10.OR.Q(JJ).LT.6)GO TO SPA
49700 CAME 3,[10.0]
49800 JRST SPA
49900 CAMLE Q-1(13)
50000 JRST SPA
50100
50200 SETO 3, ;M=0 (-1)
50300 MOVE 5,Q-1(13) ; KK=Q(JJ)+2
50400 FIXX(5) ;DO SPB N=K,KK
50500 ADDI 5,2 ; KK
50550 MOVEI 7,(6) ; (N=K)
50560 ADDI 5,(7) ; (KK=K+KK+JJ-1)
50580 ADDI 5,(4)
50590 ;; SOJ 5, ; THE TOTAL NUM OF ITEMS TO SCRAMBLE
50600 SPB: MOVE Q-1(7) ;M=M+1
50700 AOJ 3, ; M
50800 MOVEM XRN(3) ;SPB RN(M)=Q(N)
50900 CAIGE 7,(5)
51000 AOJA 7,SPB
51100
51200 MOVEI 3,(13) ; JJ
51300 SUB 3,6 ; M=JJ-K (-1)
51400 MOVEI 7,(5) ; KK
51500 SUB 7,13 ; J=KK-JJ
51600 MOVEI 11,(7) ; KA=J
51700 ADDI 11,(6) ; +K
51800 ;; SOJ 11, ;KA=K+J-1
51900 MOVEI 12,(6) ; N=K
51910 MOVEI 14,(12)
51920 MOVE 15,XRN+3(3) ; SAVE POS (R3)
52000 SPC: MOVE XRN(3) ;DO SPB N=K,KA
52100 MOVEM Q-1(12) ; M=M+1
52200 AOJ 3, ;SPC Q(N)=RN(M)
52300 CAIGE 12,(11)
52400 AOJA 12,SPC
52500
52600 MOVEI 13,(6) ; JJ=K+J
52700 ADDI 13,(7) ; JJ
52800 SETZ 3, ; M=0
52900 SOJ 5, ; KK-1
52910 MOVE 7,XRN+3(3) ; POS OF THIS ITEM
52920 MOVEM 7,Q+2(14) ;EXCHANGE THEM
52930 MOVEM 15,XRN+3(3)
53000 SPD: MOVE XRN(3) ;DO SPD N=JJ,KK-1
53100 MOVEM Q(13) ; M=M+1
53200 AOJ 3, ;SPD Q(N)=RN(M)
53300 CAIGE 13,(5)
53400 AOJA 13,SPD ; ALL THIS TO FIND NUM AFTER WHOLE REST.
53510 JRST SP ;GO BACK TO GET RIGHT PNTRS NOW.
53600 ;K=K+JJ
53700 SPA: ADDI 6,(4) ; -K- (KK=KK+1)
54000 CAMGE 6,@(16) ;IF(K.LT.KQ)GO TO 220
54100 AOJA 2,SP
54200 AOJ 2, ;PN(KK)=K
54300 MOVEM 6,PX-1(2)
54400 MOVEM 2,LLL ;L=KK
54500 JRA 16,1(16)
54600
54700
54800 SHFT0: 0 ; CALL SHFT0(KQ)
54900 MOVE 2,LLL ; L
55000 MOVE 4,PTR-1(2)
55100 ;; FIXX(4)
55200 SOJ 4,
55300 MOVE 2,@(16) ; KQ
55400 ;; SETZ 3, ; K
55500 ;;SH32: MOVE XRN(3) ; DO 32 K=1,IFIX(PWDS(L))-1
55600 ;; MOVEM Q(2) ; KQ=KQ+1
55700 ;; AOJ 3,
55800 ;; CAME 3,4
55900 ;; AOJA 2,SH32
56000 ;; AOJ 2, ; 32 Q(KQ)=RN(K)
56100 HRLZI 3,XRN ; PUT ADDR OF RN IN LEFT HALF
56200 HRRI 3,Q(2) ; ADDR OF NEXT OPEN SLOT OF Q IN RIGHT HALF
56300 ADDI 2,(4) ; TO LOCATE END OF TRANSFER
56400 BLT 3,Q(2) ; THESE REPLACE THE ';;' ABOVE
56500 MOVEM 2,@(16) ; NEW VALUE OF KQ
56600 MOVEI 1
56700 MOVEM LLL ; L
56800 MOVEM XXX ; LK
56900 JRA 16,1(16)
57000
57100 PSHFT: 0 ; CALL PSHFT(KK,K)
57200 MOVE 6,@1(16)
57300 MOVE 2,@(16)
57400 MOVE 2,PX-1(2)
57500 ;; FIXX(2) ; NA
57600 ;C DO 31 NA=IFIX(PN(KK)),IFIX(PN(K+1)-1.)
57700 MOVE 3,PX(6) ; RN(KL)=Q(NA)
57800 ;; FIXX(3) ; 31 KL=KL+1
57900 MOVE 4,SF ; KL
58000 PS31: MOVE 5,Q-1(2)
58100 MOVEM 5,XRN-1(4)
58200 AOJ 2,
58300 CAIE 2,(3)
58400 AOJA 4,PS31
58500 AOJ 4,
58600 MOVEM 4,SF ; KL
58700 AOJ 6,
58800 MOVEM 6,@(16) ; KK
58900 JRA 16,2(16)
59000
59100 ; SUBROUTINE ADDRST(RPOS,XWDS,PN)
59200 ; COMMON /XXX/LK,LP,JY /PTR/PWDS(250),L,LL,I,IX
59300 ; COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
59400 ; DIMENSION XWDS(1),PN(1)
59500
59600 ADRST: 0 ; PN(LK)=6
59700 MOVE 1,XXX ; LK
59800 MOVE 6,[6.0] ; CALL ADRST(XWDS)
59900 MOVEM 6,PX-1(1)
60000 MOVE 2,[2.0] ; PN(LK+1)=2
60100 MOVEM 2,PX(1)
60200 ;; MOVE 13,.COMM. ; PN(LK+2)=RS
60300 SETZM PX+1(1)
60400 MOVE 3,SHFT1 ; PN(LK+3)=RPOS-1. (SHFT1 SAVED 'RR')
60500 MOVEM 3,PX+=11(1) ; SEE (LK+3) BELOW
60600 FSBR 3,[1.0]
60700 MOVEM 3,PX+2(1)
60800 SETZM PX+3(1) ; PN(LK+4)=0
60900 SETZM PX+4(1) ; PN(LK+5)=0
61000 SETZM PX+5(1) ; PN(LK+6)=0
61100 MOVEM 6,PX+6(1) ; PN(LK+7)=6.
61200 MOVE 10,[1.0]; PN(LK+8)=-1
61300 MOVNM 10,PX+7(1)
61400 ; LK=LK+9
61500 ; L=L+1
61600 ; XWDS(L)=LK
61700 ; NEXT ADDS A BAR LINE
61800 MOVEM 2,PX+=8(1) ; PN(LK)=2
61900 MOVE [4.0] ; PN(LK+1)=4
62000 MOVEM PX+=9(1)
62100 ;; MOVEM 13,PX+=10(1) ; PN(LK+2)=RS
62200 SETZM PX+=10(1)
62300 ; PN(LK+3)=RPOS (SEE ABOVE)
62400 MOVEM 10,PX+=12(1) ; PN(LK+4)=1.
62500 ; LK=LK+5
62600 ; L=L+1
62700 ; XWDS(L)=LK
62800 ; END
62900 MOVE 2,LLL ; L
63000 HRRZ 3,(16) ; ADDR OF XWDS
63100 ADDI 3,(2)
63200 ADDI 1,=9
63300 MOVE 4,1
63400 ;; TLC 4,232000 ; NEXT FLOATS IT
63500 ;; FADR 4,4
63600 MOVEM 4,(3) ;XWDS(L)=LK
63700 ;; AOJ 3,
63800 ADDI 4,5
63900 MOVEM 4,1(3) ;XWDS(L+1)=LK
64000 ADDI 2,2
64100 MOVEM 2,LLL ;L=L+2
64200 ADDI 1,5
64300 MOVEM 1,XXX ;LK=LK+14
64400 JRA 16,1(16)
64500
64600 ENDL: 0
64700 MOVE 5,[4.0]
64800 SETZ 2, ; JJ
64900 MOVEI 3,1 ; K
65000 E7: MOVE 4,PX-1(3)
65100 ;; FIXX(4)
65200 CAME 5,Q(4)
65300 JRST E77
65400 AOJ 2,
65500 MOVE Q+2(4)
65600 MOVEM XRN-1(2)
65700 E77: CAMGE 3,LLL
65800 AOJA 3,E7
65900 MOVEM 2,@(16)
66000 JRA 16,1(16)
66100
66200 STAFF: 0 ; SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
66300 ;; COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
66400 ;; COMMON /PTR/PWDS(250),L,LL,I,IX
66500 MOVE 2,SF+2 ; KP PWDS(KP)=KL
66600 MOVE 4,SF ; KL
66700 MOVEI 3,(4)
66800 ;; TLC 3,232000 ; FLOAT
66900 ;; FADR 3,3
67000 MOVEM 3,PTR-1(2)
67100 AOJ 2, ; KP=KP+1
67200 MOVEM 2,SF+2
67300 MOVE 2,@(16) ; RN(KL)=P0
67400 MOVEM 2,XRN-1(4)
67500 MOVE @1(16) ; RN(KL+1)=P1
67600 MOVEM XRN(4)
67700 MOVE SF+1 ; RN(KL+2)=RT
67800 MOVEM XRN+1(4)
67900 MOVE @2(16) ; RN(KL+3)=P3
68000 MOVEM XRN+2(4)
68100 MOVE @3(16) ; RN(KL+4)=P4
68200 MOVEM XRN+3(4)
68300 MOVE @4(16) ; RN(KL+5)=P5
68400 MOVEM XRN+4(4)
68500 CAMGE 2,[4.0] ; IF(P0.LT.4.)GO TO 1
68600 JRST ST1
68700 MOVE @5(16) ; RN(KL+6)=P6
68800 MOVEM XRN+5(4)
68900 CAMGE 2,[5.0] ; IF(P0.LT.5)GO TO 1
69000 JRST ST1
69100 MOVE @6(16) ; RN(KL+7)=P7
69200 MOVEM XRN+6(4)
69300 CAMGE 2,[6.0] ; IF(P0.LT.6)GO TO 1
69400 MOVEM XRN+6(4)
69500 MOVE @7(16) ; RN(KL+8)=P8
69600 MOVEM XRN+7(4)
69700 ST1: FIXX(2) ;1 KL=KL+P0+3.
69800 ADDI 2,3
69900 ADDM 2,SF
70000 JRA 16,8(16) ; END
70100
70200 RIGHT: 0 ; FUNCTION RIGHT(NA,J)
70300 ;; COMMON /PX/PN(1800) /Q/Q(9000)
70400 MOVE 4,@(16) ; NA K=NA+J
70500 ADD 4,@1(16) ; +J J IS EITHER +1 OR -1
70600 MOVE 5,[16.0]
70700 RT1: MOVE 3,PX-1(4) ; 1 L=PN(K)
70800 ;; FIXX(3) ; L
70900 ;; MOVE Q(3) ; IF(Q(L+1).NE.16)GO TO 2
71000 ;; CAME [16.0] ; **** CAN'T USE AC2 - USED IN FORTRAN
71100 CAME 5,Q(3)
71200 JRST RT2
71300 ADD 4,@1(16) ; K=K+J
71400 JRST RT1 ; GO TO 1
71500 RT2: MOVE Q+2(3) ; 2 RIGHT=Q(L+3)
71600 JRA 16,2(16) ; END
71700
71800 LOOP1: 0 ;CALL LOOP1
71900 ;;; MOVE 1,[8.0] ; RSTAFF=RSTAFF+8
72000 ;;; FADRB 1,RCLF+4
72050 MOVE 1,RCLF+4 ;RSTAFF IS UPDATED EARLIER.
72100 MOVE 2,RCLF+2
72200 P477: MOVE 4,RCLF ; DO 477 K=KW,ITEM+1
72300 ADDB 4,PTR-1(2) ; PWDS(K)=PWDS(K)+R
72400 ;; FIXX(4) ; LA=PWDS(K)+2
72500 FADRM 1,XRN+1(4) ;477 RN(LA)=RN(LA)+RSTAFF
72600 CAMG 2,RCLF+3
72700 AOJA 2,P477
72800 JRA 16,(16) ; FOR COMBINED FILES
72900
73000 RESTS: 0 ;XLFT=0 -- CALL RESTS
73100 SETZ 2,
73200 MOVE 12,[4.0]
73250
73275 MOVE 13,[16.0] ; TO CATCH WORDS
73300 MOVN 3,[99.0] ;SIG=-99
73400 ;; MOVE 4,3 ;CLEF=-99
73500 SETZ 6, ; REST=0
73600 MOVEI 7,1 ;K=1
73700 RX50: MOVE 10,PX-1(7) ;50 JL=PN(K)
73800 ;; FIXX(10)
73900 MOVE 11,Q(10) ;R=Q(JL+1)
74000 JUMPN 2,RX5 ;IF(XLFT.NE.0)GO TO 5
74100 CAMLE 11,[4.0] ;IF(R.LE.4)XLFT=Q(JL+3)
74200 JRST RX5
74300 MOVE 2,Q+2(10)
74400 MOVEM 2,.COMM.+=13
74500 JRST RX3
74600 RX5: CAME 11,[17.0] ;5 IF(R.NE.17)GO TO 3
74700 JRST RX3
74800 MOVE 1,Q+4(10) ;IF(Q(JL+5).EQ.SIG)GO TO 60
74900 CAMN 1,3
75000 JRST RX60
75100 MOVE 3,1 ;SIG=Q(JL+5)
75200 RX3: CAME 11,[2.0] ;3 IF(R.NE.2)GO TO 231
75300 JRST RX231
75400 MOVE Q-1(10) ;IF(Q(JL).GE.6)GO TO 7
75500 CAML [6.0]
75600 JRST RX7
75610
75620 JRST RX231 ;NEXT (TO RX7) DOESN'T WORK YET. NEEDS TO EXPND DATA!
75700 MOVE 1,PX-2(7) ;IF(Q(IFIX(PN(K-1))+1).NE.4)GO TO 231
76100 CAMN 12,Q(1)
76200 JRST RX55 ; ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
76210 CAME 13,Q(1)
76220 JRST RX231 ; IF NOT WORDS, JUMP
76230 MOVE 14,PX-3(7)
76240 CAME 12,Q(14) ; IS THIS ONE A BAR?
76250 JRST RX231 ; NO
76300 ; WON'T CATCH IT IF THERE IS A CLEF, METER, ETC. PRESENT
76400 RX55: MOVE 1,PX(7) ;IF(Q(IFIX(PN(K+1))+1).NE.4)GO TO 231
76800 CAME 12,Q(1)
76900 JRST RX231
77000 ; FOUND A WHOLE REST MEAS.
77010
77100 RX7: JUMPN 6,RX6 ;7 IF(REST.NE.0)GO TO 6
77200 MOVEI 13,(10) ;JR=JL+8
77300 ADDI 13,6
77400 ; POINTER TO REST NUM.
77500 MOVE 11,Q(13) ;R=Q(JR-1)
77600 CAMGE 11,[5.0] ;IF(R.LT.5)R=5
77700 MOVE 11,[5.0]
77800 FMPR 11,[0.6] ;Q(JR-1)=R*.6
77900 MOVEM 11,Q(13)
78000 ; REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
78100 RX6: FADR 6,[1.0] ;6 REST=REST+1
78200 MOVEM 6,Q+1(13) ;Q(JR)=REST
78220 MOVN [2.0]
78240 MOVEM Q-3(13) ;Q(JR-4)=-2 (LOWER THE REST'S POS.)
78300 MOVEI 10,(7) ;JL=K+2
78400 ADDI 10,2
78500 CAML 10,LLL ;IF(JL.GE.L)RETURN
78600 JRA 16,(16)
78700 MOVE 14,PX-1(10) ;LB=PN(JL)
78800 ;; FIXX(14)
78900 MOVE Q(14) ;IF(Q(LB+1).NE.2)GO TO 233
79000 CAME [2.0]
79100 JRST RX233 ; NEXT IS TO COMBINE MEASURES OF REST
79200 MOVE Q-1(14) ;IF(Q(LB).LT.6)GO TO 233
79300 CAMGE [6.0]
79400 JRST RX233
79500 ; SKIP NON-WHOLE RESTS
79600 MOVE 15,PX-2(10) ;N=PN(JL-1)
79700 ;; FIXX(15)
79800 ;; MOVE Q(15) ;IF(Q(N+1).NE.4)GO TO 233
79900 ;; CAME [4.0]
80000 CAME 12,Q(15)
80400 JRST RX233
80500 ; IS REST FOLLOWED BY A BAR? OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
80600 ; SO IT WON'T BE FOUND NEXT TIME AROUND.
80700 MOVN [1.0] ;Q(LB+1)=-1
80800 MOVEM Q(14)
80900 ; CHANGE CODE #
81000 MOVEM Q(15) ;Q(N+1)=-1
81100 MOVEI 7,(10) ;K=JL
81200 JRST RX6 ;GO TO 6
81300 RX60: MOVE [1.0] ;60 Q(JL+1)=-1
81400 MOVNM Q(10)
81500 JRST RX231 ;GO TO 231
81600 RX233: SETZ 6, ;233 REST=0
81700 RX231: AOJ 7, ;231 K=K+1
81800 CAMGE 7,LLL ;IF(K.LT.L)GO TO 50
81900 JRST RX50
82000 JRA 16,(16) ; END
82100
82200 EXCHG: 0 ;CALL EXCHG(MM(J),NN(J))
82300 HRRZI 1,@(16) ; ADDR OF MM(J)
82400 MOVE 2,1(1) ;VALUE OF MM(J+1)
82500 EXCH 2,@(16) ;EXCHANGE
82600 MOVEM 2,1(1) ; MM(J+1)
82700 HRRZI 1,@1(16) ; ADDR OF NN(J)
82800 MOVE 2,1(1) ;VALUE OF NN(J+1)
82900 EXCH 2,@1(16) ;EXCHANGE
83000 MOVEM 2,1(1) ; NN(J+1)
83100 JRA 16,2(16)
83200
83300
83400 SHRNK: 0 ;CALL SHRNK(K,IT)
83500 MOVE 10,@1(16)
83600 MOVE 11,PX(10) ;END OF Q DATA
83700 SOJ 10,
83800 MOVE 2,@(16) ;K
83900 MOVEI 12,(2)
84000 MOVE 3,PX-1(2) ;PTR TO Q(n)
84100 MOVEI 6,(3) ;SAME
84200 MOVE 4,PX(2) ;PTR TO NEXT ITEM
84300 MOVEI 1,(4) ;TO USE IN BLT
84400 SUBI 3,(4) ;WDCCNT OF DELETE ITEM
84500 ;; MOVE 7,3 ; SAVE THIS DIFF.
84600 SUB 4,PX+1(2) ; NEXT +1
84700 SUB 3,4 ; AMOUNT OF CHANGE
84800 ;;SK: ADDM 3,PX(2) ;KPN(n)=KPN(n)+L
84900 ;; CAME 2,@1(16)
85000 ;; AOJA 2,SK ; THE LOOP
85100 SK: MOVE 5,PX+1(2)
85200 SUB 5,PX(2)
85300 ADD 5,PX-1(2)
85400 MOVEM 5,PX(2)
85500 ;; CAME 2,@1(16)
85600 CAIE 2,(10)
85700 AOJA 2,SK
85800 ;; SOS @1(16) ;IT=IT-1
85900 ;; SOJ 2,
86000 ;; ADDM 7,PX(2)
86100 ;; MOVEM 2,@1(16)
86200 MOVE 2,PX(2) ; LAST PTR
86300 MOVE 7,Q+2(6) ;POS FOR LATER "MOVE"
86400 ;;SK2: HRLZI 1,Q-1(1) ;PICK IT UP
86500 ;; HRRI 1,Q-1(6) ;PUT IT HERE
86600 ;; MOVNS 3 ;--WDCNT
86700 ;; ADDI 3,(2) ;PTR TO OLD END OF LIST
86800 ;; BLT 1,Q-1(3) ;UNTIL END OF DATA
86900 SK2: MOVE Q-1(1)
87000 MOVEM Q-1(6)
87100 AOJ 1,
87200 CAIE 1,(11)
87300 AOJA 6,SK2
87400 MOVEM 10,@1(16)
87500 AOJ 10, ; TO GET TO END OF DATA.
87600 MOVEM 10,LLL
87700 MOVEM 7,.COMM.+5 ;R4
87800 MOVN 5,[8.0]
87900 SKMV: SETZM LLL+1 ;LL=0 (NO JUSTIFY)
88000 MOVE 2,[20000.0]
88100 MOVEM 2,.COMM.+6 ;R5
88200 SETZM .COMM. ;RS
88300 SETZM .COMM.+=10 ;R9
88400 SETZM .COMM.+=8 ;R7
88500 FMPR 5,STF+=8 ;*RSTJ2
88600 MOVEM 5,.COMM.+=9 ;R8=MOVE DIST.(-8)
88700 ;; MOVE 2,@1(16)
88800 ;; MOVEM 2,LLL ;END OF DATA
88900 ;; MOVEI 11,PX-1(6) ;START OF DATA
89000 JSA 16,PTMOVE
89100 JUMP Q
89200 JUMP PX-1(12)
89300 JRA 16,2(16)
89400
89500 EXPND: 0 ; TO SHIFT LINE TO RT. WHEN ADDING KSIG.
89600 MOVE 5,[5.0]
89700 MOVE 2,[7.1]
89800 FMPR 2,STF+=8
89900 MOVEM 2,.COMM.+5 ;R4=7*RSTJ2+.1
90000 MOVE 12,@(16) ; GET PTR TO PX
90100 ADDI 12,2 ; ADD 2 (FOR NOW, ANYWAY)
90200 SETZM .COMM.+=9
90300 JRST SKMV ; GO MOVE IT
90400
90500 CLFNUM: 0 ;X=CLFNUM(Q,PX,MS) (FUNCTION)
90600 MOVEI 2,@1(16) ;GET PX'S ADDR
90700 ADD 2,@2(16)
90800 MOVE 2,(2) ;PX(MS)
90900 MOVEI 1,@(16) ; ADDR OF Q
91000 ADD 2,1 ;ADDR OF Q(PX(MS)+1)
91100 MOVE 5(2) ;X=Q(PX(MS)+5)
91200 MOVE 1,-1(2)
91300 CAMGE 1,[3.0] ;IF (Q( ).LT.3)X=0
91400 SETZ ; ANSWER IN AC0
91500 JRA 16,3(16)
91600
91700 SLRV: 0 ; CALL SLRV(KK,C)
91800 MOVE 1,@(16) ; KK
91900 MOVE 2,@1(16) ; C
92000 FADRM 2,Q+3(1) ; WORKS WITH Q ARRAY ONLY******
92100 FADRM 2,Q+4(1) ; FOR Q(KK+4) AND (KK+5)
92200 MOVNS Q+6(1) ; Q(KK+7)
92300 JRA 16,3(16)
92400
92500 END